home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
A-COMAL Series
/
(k)aaf.d64
/
proc.xactcopy
< prev
next >
Wrap
Text File
|
2007-02-28
|
957b
|
32 lines
0010 //
0020 PROC XACTCOPY CLOSED
0030 USE SYSTEM
0040 USE FONT
0050 DIM RASTER$ OF 8
0060 DIM XRASTER$ OF 8
0070 SET:=PEEK($D018)
0080 IF SET=23 THEN CHARSET:=3
0090 IF SET=21 THEN CHARSET:=2
0100 IF SET=191 THEN CHARSET:=1
0110 IF SET=189 THEN CHARSET:=0
0120 RASTER$(1:8):=""
0130 XRASTER$(1:8):=""
0140 OPEN FILE 78,"U4:/T+/S0",WRITE
0150 PRINT FILE 78: CHR$(27),CHR$(65),CHR$(8)
0160 SCREENLOC:=PEEK($0288)*256
0170 FOR COL#:=0 TO 39 DO
0180 PRINT FILE 78: CHR$(27),CHR$(75),CHR$(200),CHR$(0),
0190 FOR LINE#:=24 TO 0 STEP -1 DO
0200 CHAR:=PEEK(SCREENLOC+LINE#*40+COL#)
0210 GETCHARACTER(CHARSET,CHAR,RASTER$)
0220 FOR FLIP:=1 TO 8 DO
0230 XRASTER$(9-FLIP):=RASTER$(FLIP)
0240 ENDFOR FLIP
0250 PRINT FILE 78: XRASTER$,
0260 ENDFOR LINE#
0270 PRINT FILE 78: CHR$(10)
0280 ENDFOR COL#
0290 PRINT FILE 78: CHR$(27),CHR$(64)
0300 CLOSE FILE 78
0310 ENDPROC XACTCOPY